home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / ghostscr / gs252ini.zip / BDFTOPS.PS < prev    next >
Text File  |  1992-08-19  |  24KB  |  756 lines
  1. %    Copyright (C) 1990, 1991 Aladdin Enterprises.  All rights reserved.
  2. %    Distributed by Free Software Foundation, Inc.
  3. %
  4. % This file is part of Ghostscript.
  5. %
  6. % Ghostscript is distributed in the hope that it will be useful, but
  7. % WITHOUT ANY WARRANTY.  No author or distributor accepts responsibility
  8. % to anyone for the consequences of using it or for whether it serves any
  9. % particular purpose or works at all, unless he says so in writing.  Refer
  10. % to the Ghostscript General Public License for full details.
  11. %
  12. % Everyone is granted permission to copy, modify and redistribute
  13. % Ghostscript, but only under the conditions described in the Ghostscript
  14. % General Public License.  A copy of this license is supposed to have been
  15. % given to you along with Ghostscript so you can know your rights and
  16. % responsibilities.  It should be in a file named COPYING.  Among other
  17. % things, the copyright notice and this notice must be preserved on all
  18. % copies.
  19.  
  20. % bdftops.ps
  21. % Convert a BDF file (possibly with (an) associated AFM file(s))
  22. % to a Ghostscript font.
  23.  
  24. % Ghostscript fonts are in the same format as Adobe Type 1 fonts,
  25. % except that they do not use eexec encryption.
  26. % See gs_fonts.ps for more information.
  27.  
  28. /envBDF 120 dict def
  29. envBDF begin
  30.  
  31. % "Import" the image-to-path package.
  32. % This also brings in the Type 1 opcodes (type1ops.ps).
  33.    (impath.ps) run
  34.  
  35. % "Import" the font-writing package.
  36.    (wrfont.ps) run
  37.  
  38. % Invert the StandardEncoding vector.
  39.    256 dict dup begin
  40.    0 1 255 { dup StandardEncoding exch get exch def } for
  41.    end /decoding exch def
  42.  
  43. % Define the dictionary equivalent of ].
  44.    /dicttomark
  45.     { counttomark 2 idiv dup dict begin
  46.        { def } repeat
  47.       pop currentdict end 
  48.     } bind def
  49.  
  50. % Define the properties copied to FontInfo.
  51.    mark
  52.      (COPYRIGHT) /Notice
  53.      (FAMILY_NAME) /FamilyName
  54.      (FULL_NAME) /FullName
  55.      (WEIGHT_NAME) /Weight
  56.    dicttomark /properties exch def
  57.  
  58. % Define the character sequences used to fill in some undefined entries
  59. % in the standard encoding.
  60.    mark
  61.      (AE) [/A /E]
  62.      (OE) [/O /E]
  63.      (acute) [/quoteright]
  64.      (ae) [/a /e]
  65.      (bullet) [/asterisk]
  66.      (cedilla) [/comma]
  67.      (circumflex) [/asciicircum]
  68.      (dieresis) [/quotedbl]
  69.      (dotlessi) [/i]
  70.      (ellipsis) [/period /period /period]
  71.      (emdash) [/hyphen /hyphen /hyphen]
  72.      (endash) [/hyphen /hyphen]
  73.      (exclamdown) [/exclam]
  74.      (fi) [/f /i]
  75.      (fl) [/f /l]
  76.      (florin) [/f]
  77.      (fraction) [/slash]
  78.      (germandbls) [/s /s]
  79.      (grave) [/quoteleft]
  80.      (guillemotleft) [/less /less]
  81.      (guillemotright) [/greater /greater]
  82.      (guilsinglleft) [/less]
  83.      (guilsinglright) [/greater]
  84.      (hungarumlaut) [/quotedbl]
  85.      (oe) [/o /e]
  86.      (periodcentered) [/asterisk]
  87.      (questiondown) [/question]
  88.      (quotedblbase) [/comma /comma]
  89.      (quotedblleft) [/quotedbl]
  90.      (quotedblright) [/quotedbl]
  91.      (quotesinglbase) [/comma]
  92.      (quotesingle) [/quoteright]
  93.      (tilde) [/asciitilde]
  94.    dicttomark /composites exch def
  95.  
  96. % Note the characters that must be defined as subroutines.
  97.    96 dict begin
  98.      0 composites
  99.       { exch pop
  100.          { dup currentdict exch known
  101.         { pop }
  102.         { 1 index def 1 add }
  103.        ifelse
  104.      }
  105.     forall
  106.       }
  107.      forall pop
  108.      currentdict
  109.    end /subrchars exch def
  110.  
  111. % Define the overstruck characters that can be synthesized with seac.
  112.    mark
  113.     [ /Aacute /Acircumflex /Adieresis /Agrave /Aring /Atilde
  114.       /Ccedilla
  115.       /Eacute /Ecircumflex /Edieresis /Egrave
  116.       /Iacute /Icircumflex /Idieresis /Igrave
  117.       /Lslash
  118.       /Ntilde
  119.       /Oacute /Ocircumflex /Odieresis /Ograve /Otilde
  120.       /Scaron
  121.       /Uacute /Ucircumflex /Udieresis /Ugrave
  122.       /Yacute /Ydieresis
  123.       /Zcaron
  124.       /aacute /acircumflex /adieresis /agrave /aring /atilde
  125.       /ccedilla
  126.       /eacute /ecircumflex /edieresis /egrave
  127.       /iacute /icircumflex /idieresis /igrave
  128.       /lslash
  129.       /ntilde
  130.       /oacute /ocircumflex /odieresis /ograve /otilde
  131.       /scaron
  132.       /uacute /ucircumflex /udieresis /ugrave
  133.       /yacute /ydieresis
  134.       /zcaron
  135.     ]
  136.     { dup dup length string cvs
  137.       [ exch dup 0 1 getinterval
  138.         exch dup length 1 sub 1 exch getinterval
  139.       ]
  140.     } forall
  141.      /cent [/c /slash]
  142.      /daggerdbl [/bar /equal]
  143.      /divide [/colon /hyphen]
  144.      /sterling [/L /hyphen]
  145.      /yen [/Y /equal]
  146.    dicttomark /accentedchars exch def
  147.  
  148. % ------ BDF file parsing utilities ------ %
  149.  
  150. % Define a buffer for reading the BDF file.
  151.    /buffer 400 string def
  152.  
  153. % Read a line from the BDF file into the buffer.
  154. % Define /keyword as the first word on the line.
  155. % Define /args as the remainder of the line.
  156. % If the keyword is equal to commentword, skip the line.
  157. % (If commentword is equal to a space, never skip.)
  158.    /nextline
  159.     { bdfile buffer readline not
  160.        { (Premature EOF\n) print stop } if
  161.       ( ) search
  162.        { /keyword exch def pop }
  163.        { /keyword exch def () }
  164.       ifelse
  165.       /args exch def
  166.       keyword commentword eq { nextline } if
  167.     } bind def
  168.  
  169. % Get a word argument from args.  We do *not* copy the string.
  170.    /warg        % warg -> string
  171.     { args ( ) search
  172.        { exch pop exch }
  173.        { () }
  174.       ifelse  /args exch def
  175.     } bind def
  176.  
  177. % Get an integer argument from args.
  178.    /iarg        % iarg -> int
  179.     { warg cvi
  180.     } bind def
  181.  
  182. % Get a numeric argument from args.
  183.    /narg        % narg -> int|real
  184.     { warg cvr
  185.       dup dup cvi eq { cvi } if
  186.     } bind def
  187.  
  188. % Convert the remainder of args into a string.
  189.    /remarg        % remarg -> string
  190.     { args copystring
  191.     } bind def
  192.  
  193. % Get a string argument that occupies the remainder of args.
  194.    /sarg        % sarg -> string
  195.     { args (") anchorsearch
  196.        { pop /args exch def } { pop } ifelse
  197.       args args length 1 sub get (") 0 get eq
  198.        { args 0 args length 1 sub getinterval /args exch def } if
  199.       args copystring
  200.     } bind def
  201.  
  202. % Check that the keyword is the expected one.
  203.    /checkline        % (EXPECTED-KEYWORD) checkline ->
  204.     { dup keyword ne
  205.        { (Expected ) print =
  206.          (Line=) print keyword print ( ) print args print (\n) print stop
  207.        } if
  208.       pop
  209.     } bind def
  210.  
  211. % Read a line and check its keyword.
  212.    /getline        % (EXPECTED-KEYWORD) getline ->
  213.     { nextline checkline
  214.     } bind def
  215.  
  216. % Find the first/last non-zero bit of a non-zero byte.
  217.    /fnzb
  218.     { 0 { exch dup 128 ge { pop exit } { dup add exch 1 add } ifelse }
  219.       loop
  220.     } bind def
  221.    /lnzb
  222.     { 7 { exch dup 1 and 0 ne { pop exit } { -1 bitshift exch 1 sub } ifelse }
  223.       loop
  224.     } bind def
  225.  
  226. % ------ Type 1 encoding utilities ------ %
  227.  
  228. % Parse the side bearing and width information that begins a CharString.
  229. % Arguments: charstring.  Result: mark sbx wx substring *or*
  230. % mark sbx sby wx wy substring.
  231.    /parsesbw
  232.     { mark exch lenIV
  233.        {        % stack: mark ... string dropcount
  234.          dup 2 index length exch sub getinterval
  235.      dup 0 get dup 32 lt { pop exit } if
  236.      dup 246 le
  237.       { 139 sub exch 1 }
  238.       { dup 250 le
  239.          { 247 sub 8 bitshift 108 add 1 index 1 get add exch 2 }
  240.          { dup 254 le
  241.             { 251 sub 8 bitshift 108 add 1 index 1 get add neg exch 2 }
  242.         { pop dup 1 get 128 xor 128 sub
  243.           8 bitshift 1 index 2 get add
  244.           8 bitshift 1 index 3 get add
  245.           8 bitshift 1 index 4 get add exch 5
  246.         } ifelse
  247.          } ifelse
  248.       } ifelse
  249.        } loop
  250.     } bind def 
  251.  
  252. % Find the side bearing and width information that begins a CharString.
  253. % Arguments: charstring.  Result: charstring sizethroughsbw.
  254.    /findsbw
  255.     { dup parsesbw counttomark 1 add 1 roll cleartomark skipsbw
  256.     } bind def
  257.    /skipsbw        % charstring sbwprefix -> sizethroughsbw
  258.     { length 1 index length exch sub
  259.       2 copy get 12 eq { 2 } { 1 } ifelse add
  260.     } bind def
  261.  
  262. % Encode a number, and append it to a string.
  263. % Arguments: str num.  Result: newstr.
  264.    /concatnum
  265.     { dup dup -107 ge exch 107 le and
  266.        { 139 add 1 string dup 0 3 index put }
  267.        { dup dup -1131 ge exch 1131 le and
  268.           { dup 0 ge { 16#f694 } { neg 16#fa94 } ifelse add
  269.         2 string dup 0 3 index -8 bitshift put
  270.         dup 1 3 index 255 and put
  271.       }
  272.       { 5 string dup 0 255 put exch
  273.         2 copy 1 exch -24 bitshift 255 and put
  274.         2 copy 2 exch -16 bitshift 255 and put
  275.         2 copy 3 exch -8 bitshift 255 and put
  276.         2 copy 4 exch 255 and put
  277.         exch
  278.       }
  279.      ifelse
  280.        }
  281.       ifelse exch pop concatstrings
  282.     } bind def
  283.  
  284. % Encode a subroutine call for a given character, appending it to a string.
  285. % Arguments: str subrindex.  Result: newstr.
  286.    /concatcall
  287.     { () exch concatnum
  288.       s_callsubr concatstrings concatstrings
  289.     } bind def
  290.  
  291. % ------ Point arithmetic utilities ------ %
  292.  
  293.    /ptadd { exch 4 -1 roll add 3 1 roll add } bind def
  294.  
  295.    /ptexch { 4 2 roll } bind def
  296.  
  297.    /ptneg { neg exch neg exch } bind def
  298.  
  299.    /ptsub { ptneg ptadd } bind def
  300.  
  301. % ------ The main program ------ %
  302.  
  303.    /readBDF        % infilename outfilename fontname encodingname
  304.             %   uniqueID readBDF -> font
  305.     { /uniqueID exch def
  306.       /encoding exch def
  307.       /fontname exch def
  308.       /psname exch def
  309.       /bdfname exch def
  310.       gsave        % so we can set the CTM to the font matrix
  311.  
  312. %  Open the input files.  We don't open the output file until
  313. %  we've done a minimal validity check on the input.
  314.       bdfname (r) file /bdfile exch def
  315.       /commentword ( ) def
  316.  
  317. %  Check for the STARTFONT.
  318.       (STARTFONT) getline
  319.       args (2.1) ne { (Not version 2.1\n) print stop } if
  320.  
  321. %  Initialize the font.
  322.       /Font 20 dict def
  323.       Font begin
  324.       /FontName fontname def
  325.       /PaintType 0 def
  326.       /FontType 1 def
  327.       /UniqueID uniqueID def
  328.       /Encoding encoding cvx exec def
  329.       /FontInfo 20 dict def
  330.       /Private 20 dict def
  331.       currentdict end currentdict end
  332.       exch begin begin        % insert font above environment
  333.  
  334. %  Initialize the Private dictionary in the font.
  335.       Private begin
  336.       /-! {string currentfile exch readhexstring pop} readonly def
  337.       /-| {string currentfile exch readstring pop} readonly def
  338.       /|- {readonly def} readonly def
  339.       /| {readonly put} readonly def
  340.       /BlueValues [] def
  341.       /lenIV lenIV def
  342.       /MinFeature {16 16} def
  343.       /password 5839 def
  344.       /UniqueID uniqueID def
  345.       end        % Private
  346.  
  347. %  Now open the output file.
  348.       psname (w) file /psfile exch def
  349.  
  350. %  Put out a header compatible with the Adobe "standard".
  351.       (%!FontType1-1.0: ) ws fontname wt (000.000) wl
  352.       (% This is a font description converted from ) ws
  353.         bdfname wl
  354.       (%   by bdftops running on revision ) ws
  355.       revision wt (of (a) ) ws
  356.       statusdict /product get ws (.) wl
  357.  
  358. %  Copy the initial comments, up to FONT.
  359.       true
  360.       { nextline
  361.         keyword (COMMENT) ne {exit} if
  362.     { (% Here are the initial comments from the BDF file:\n%) wl
  363.     } if false
  364.     (%) ws remarg wl
  365.       } loop pop
  366.       /commentword (COMMENT) def    % do skip comments from now on
  367.  
  368. %  Read and process the FONT, SIZE, and FONTBOUNDINGBOX.
  369.       % If we cared about FONT, we'd use it here.  If the BDF files
  370.       % from MIT had PostScript names rather than X names, we would
  371.       % care; but what's there is unusable, so we discard FONT.
  372.       (FONT) checkline
  373.       (SIZE) getline
  374.         /pointsize iarg def   /xres iarg def   /yres iarg def
  375.       (FONTBOUNDINGBOX) getline
  376.         /fbbw iarg def   /fbbh iarg def   /fbbxo iarg def   /fbbyo iarg def
  377.     /fraster fbbw 7 add 8 idiv def
  378.       nextline
  379.  
  380. % Allocate the buffers for the bitmap and the outline,
  381. % according to the font bounding box.
  382.       /bits fraster fbbh mul 200 max 65535 min string def
  383.       /outline bits length 6 mul 65535 min string def
  384.  
  385. %  The Type 1 font machinery really only works with a 1000 unit
  386. %  character coordinate system.  Set this up here.
  387.  
  388. % Compute the factor to make the X entry in the FontMatrix
  389. % come out at exactly 0.001.
  390.       /fontscale   72 pointsize div xres div 1000 mul   def
  391.       Font /FontBBox
  392.        [ fbbxo fontscale mul
  393.      fbbyo fontscale mul
  394.      fbbxo fbbw add fontscale mul
  395.      fbbyo fbbh add fontscale mul
  396.        ] cvx readonly
  397.       put
  398.  
  399. %  Read and process the properties.  We only care about a few of them.
  400.       keyword (STARTPROPERTIES) eq
  401.        { iarg
  402.           { nextline
  403.         properties keyword known
  404.          { FontInfo properties keyword get sarg readonly put
  405.          } if
  406.       } repeat
  407.          (ENDPROPERTIES) getline
  408.      nextline
  409.        } if
  410.  
  411. %  Compute and set the FontMatrix.
  412.       Font /FontMatrix
  413.        [ 0.001 0 0 0.001 xres mul yres div 0 0 ] readonly
  414.       dup setmatrix put
  415.  
  416. %  Read and process the header for the bitmaps.
  417.       (CHARS) checkline
  418.         /ccount iarg def
  419.  
  420. %  Initialize the character subroutine table and the CharStrings dictionary.
  421.       /subrs subrchars length array def
  422.       /subrsbw subrchars length array def
  423.       /subrcount 0 def
  424.       /charstrings ccount composites length add
  425.         accentedchars length add 1 add dict def        % 1 add for .notdef
  426.       /isfixedwidth true def
  427.       /fixedwidth null def
  428.  
  429. %  Read and process the bitmap data.  This reads the remainder of the file.
  430.       ccount -1 1
  431.        { (STARTCHAR) getline
  432.            /charname remarg def
  433.      (/) print charname print
  434.        10 mod 1 eq { (\n) print flush } if
  435.      (ENCODING) getline        % Ignore, assume StandardEncoding
  436.      (SWIDTH) getline
  437.        /swx iarg pointsize mul 1000 div xres mul 72 div def
  438.        /swy iarg pointsize mul 1000 div xres mul 72 div def
  439.      (DWIDTH) getline        % Ignore, use SWIDTH instead
  440.      (BBX) getline
  441.        /bbw iarg def  /bbh iarg def  /bbox iarg def  /bboy iarg def
  442.      nextline
  443.      keyword (ATTRIBUTES) eq
  444.       { nextline
  445.       } if
  446.      (BITMAP) checkline
  447.  
  448. %  Read the bits for this character.
  449.      bbw 7 add 8 idiv /raster exch def
  450. % The bitmap handed to type1imagepath must have the correct height,
  451. % because type1imagepath uses this to compute the scale factor,
  452. % so we have to clear the unused parts of it.
  453.      bits dup 0 1 raster fbbh mul 1 sub
  454.       { 0 put dup } for
  455.      pop pop
  456.      raster fbbh bbh sub mul   raster   raster fbbh 1 sub mul
  457.       { bits exch raster getinterval
  458.         bdfile buffer readline not
  459.          { (EOF in bitmap\n) print stop } if
  460.         % stack has <bits.interval> <buffer.interval>
  461.         0 () /SubFileDecode filter
  462.         exch 2 copy readhexstring pop pop pop closefile
  463.       } for
  464.      (ENDCHAR) getline
  465.  
  466. %  Compute the font entry, converting the bitmap to an outline.
  467.      bits 0 raster fbbh mul getinterval    % the bitmap image
  468.      bbw   fbbh                % bitmap width & height
  469.      swx   swy                % width x & y
  470.      bbox neg   bboy neg            % origin x & y
  471.          % Account for lenIV when converting the outline.
  472.      outline  lenIV  outline length lenIV sub  getinterval
  473.      type1imagepath
  474.      length lenIV add
  475.      outline exch 0 exch getinterval
  476.  
  477. % Check for a fixed width font.
  478.      isfixedwidth
  479.       { fixedwidth null eq
  480.          { /fixedwidth swx def }
  481.          { fixedwidth swx ne { /isfixedwidth false def } if }
  482.         ifelse
  483.       } if
  484.  
  485. % Check whether this character must be a subroutine.
  486. % If so, strip off the initial [h]sbw, replace the endchar by a return,
  487. % and put the charstring in the Subrs array.
  488.      subrchars charname known
  489.       { /charstr exch def
  490.         /csindex subrchars charname get def
  491.         charstr parsesbw counttomark 1 add 1 roll
  492.           counttomark 2 eq { 0 exch 0 } if ]
  493.           subrsbw exch csindex exch put
  494.           charstr exch skipsbw /charend exch def pop
  495.         charstr charstr length 1 sub c_return put
  496.         subrs   csindex
  497.           charstr   charend lenIV sub   dup charstr length exch sub
  498.             getinterval copystring
  499.         put
  500.         charstr 0 charend getinterval
  501.           () subrchars charname get concatcall s_endchar concatstrings
  502.           concatstrings
  503.         /subrcount subrcount 1 add def
  504.       }
  505.       { copystring }
  506.      ifelse
  507.      charname exch charstrings 3 1 roll put
  508.        } for
  509.       (ENDFONT) getline
  510.  
  511. %  Synthesize missing characters out of available ones.
  512. %  For fixed-width fonts, only do this in the 1-for-1 case.
  513.       composites
  514.        { 1 index charstrings exch known
  515.           { pop pop }
  516.       { dup isfixedwidth
  517.          { dup length 1 eq }
  518.          { true }
  519.         ifelse
  520.         exch { charstrings exch known and } forall
  521.          { ( /) print 1 index bits cvs print
  522.            dup length 1 eq
  523.             { 0 get charstrings exch get copystring }
  524.         { % Top of stack is array of characters to combine.
  525.           % Convert to an array of subr indices.
  526.           [ exch { subrchars exch get } forall ]
  527.           % The final width is the sum of the widths of all
  528.           % the characters, minus the side bearings of all the
  529.           % characters except the first.  After each character
  530.           % except the last, do a setcurrentpoint of its width
  531.           % minus its side bearing (except for the first character);
  532.           % before each character except the first, do a 0 hmoveto.
  533.           % Fortunately, all this information is available in subrsbw.
  534.           /combine exch def
  535.           lenIV string
  536.           % Compute the total width.
  537.           subrsbw combine 0 get get aload pop pop pop 2 copy
  538.           combine
  539.            { subrsbw exch get
  540.              aload pop ptexch ptsub ptadd
  541.            } forall
  542.           % Encode the combined side bearing and width.
  543.           dup 3 index or 0 eq
  544.            { pop exch pop 2 array astore s_hsbw }
  545.            { 4 array astore s_sbw }
  546.           ifelse
  547.           3 1 roll { concatnum } forall exch concatstrings
  548.           % Encode the subroutine calls, except the last.
  549.           subrsbw combine 0 get get aload pop ptexch pop pop
  550.           0 1 combine length 2 sub
  551.            { combine exch get /ccsi exch def
  552.              2 copy 5 -1 roll ccsi concatcall
  553.              3 -1 roll concatnum exch concatnum
  554.              s_setcurrentpoint_hmoveto concatstrings
  555.              subrsbw ccsi get aload pop ptexch ptsub
  556.              5 -2 roll ptadd
  557.            } for
  558.           % Encode the last call.
  559.           pop pop
  560.           combine dup length 1 sub get concatcall
  561.           s_endchar concatstrings
  562.         } ifelse
  563.            charstrings 3 1 roll put
  564.          }
  565.          { pop pop }
  566.         ifelse
  567.       }
  568.      ifelse
  569.        }
  570.       forall flush
  571.  
  572. %  Synthesize accented characters with seac if needed and possible.
  573.       accentedchars
  574.        { aload pop /accent exch def /base exch def
  575.          buffer cvs /accented exch def
  576.      charstrings accented known not
  577.      charstrings base known and
  578.      charstrings accent known and
  579.       { ( /) print accented print
  580.         charstrings base get findsbw 0 exch getinterval
  581.         /acstring exch def        % start with sbw of base
  582.         charstrings accent get parsesbw
  583.         counttomark 1 sub { pop } repeat    % just leave mark & sbx
  584.         acstring exch concatnum exch pop    % pop the mark
  585.         0 concatnum 0 concatnum        % adx ady
  586.         decoding base get concatnum        % bchar
  587.         decoding accent get concatnum    % achar
  588.         s_seac concatstrings
  589.         charstrings exch accented copystring exch put
  590.       } if
  591.        } forall
  592.  
  593. %  Make a CharStrings entry for .notdef.
  594.       outline lenIV <8b8b0d0e> putinterval    % 0 0 hsbw endchar
  595.       charstrings /.notdef outline 0 lenIV 4 add getinterval copystring put
  596.  
  597. %  Encrypt the CharStrings and Subrs (in place).
  598.       charstrings dup begin
  599.        { 4330 exch dup type1encrypt exch pop
  600.          readonly def
  601.        }
  602.       forall end
  603.       0 1 subrs length 1 sub
  604.        { dup subrs exch get dup null ne
  605.       { 4330 exch dup type1encrypt exch pop
  606.         subrs 3 1 roll put
  607.       }
  608.       { pop pop }
  609.      ifelse
  610.        }
  611.       for
  612.  
  613. %  Make most of the remaining entries in the font dictionaries.
  614.       Font /CharStrings charstrings readonly put
  615.       FontInfo /FullName known not
  616.        { % Some programs insist on FullName being present.
  617.          FontInfo /FullName FontName dup length string cvs put
  618.        }
  619.       if
  620.       FontInfo /isFixedPitch isfixedwidth put
  621.       subrcount 0 gt
  622.        { Private /Subrs subrs readonly put
  623.        } if
  624.  
  625. %  Determine the italic angle and underline position
  626. %  by actually installing the font.
  627.       save
  628.       /_temp_ Font definefont setfont
  629.       [1000 0 0 1000 0 0] setmatrix        % mitigate rounding problems
  630. % The italic angle is the multiple of -5 degrees
  631. % that minimizes the width of the 'I'.
  632.       0 9999 0 5 85
  633.        { dup rotate
  634.          newpath 0 0 moveto (I) false charpath
  635.      dup neg rotate
  636.          pathbbox pop exch pop exch sub
  637.      dup 3 index lt { 4 -2 roll } if
  638.      pop pop
  639.        }
  640.       for pop
  641. % The underline position is halfway between the bottom of the 'A'
  642. % and the bottom of the FontBBox.
  643.       newpath 0 0 moveto (A) false charpath
  644.       FontMatrix concat
  645.       pathbbox pop pop exch pop
  646. %  Put the values in FontInfo.
  647.       3 -1 roll restore
  648.       Font /FontBBox get 1 get add 2 div cvi
  649.       dup FontInfo /UnderlinePosition 3 -1 roll put
  650.       2 div abs FontInfo /UnderlineThickness 3 -1 roll put
  651.       FontInfo /ItalicAngle 3 -1 roll put
  652.  
  653. %  Clean up and finish.
  654.       grestore
  655.       bdfile closefile
  656.       Font currentdict end end begin        % remove font from dict stack
  657.       (\n) print flush
  658.  
  659.     } bind def
  660.  
  661. % ------ Reader for AFM files ------ %
  662.  
  663. % Dictionary for looking up character keywords
  664.    /cmdict 6 dict dup begin
  665.       /C { /c iarg def } def
  666.       /N { /n warg copystring def } def
  667.       /WX { /w narg def } def
  668.       /W0X /WX load def
  669.       /W /WX load def
  670.       /W0 /WX load def
  671.    end def
  672.  
  673.    /readAFM        % fontdict afmfilename readAFM -> fontdict
  674.     { (r) file /bdfile exch def
  675.       /Font exch def
  676.       /commentword (Comment) def
  677.  
  678. %  Check for the StartFontMetrics.
  679.       (StartFontMetrics) getline
  680.       args cvr 2.0 lt { (Not version 2.0 or greater\n) print stop } if
  681.  
  682. %  Look for StartCharMetrics, then parse the character metrics.
  683. %  The only information we care about is the X width.
  684.       /metrics 0 dict def
  685.        { nextline
  686.          keyword (EndFontMetrics) eq { exit } if
  687.      keyword (StartCharMetrics) eq
  688.       { iarg dup dict /metrics exch def
  689.          { /c -1 def /n null def /w null def
  690.            nextline buffer
  691.             { token not { exit } if
  692.           dup cmdict exch known
  693.            { exch /args exch def   cmdict exch get exec   args }
  694.            { pop }
  695.           ifelse
  696.         } loop
  697.            c 0 ge n null ne or w null ne and
  698.             { n null eq { /n Font /Encoding get c get def } if
  699.           metrics n w put
  700.         }
  701.            if
  702.          }
  703.         repeat
  704.         (EndCharMetrics) getline
  705.       } if
  706.        } loop
  707.  
  708. %  Insert the metrics in the font.
  709.        metrics length 0 ne
  710.         { Font /Metrics metrics readonly put
  711.     } if
  712.       Font
  713.     } bind def
  714.  
  715. end        % envBDF
  716.  
  717. % Enter the main program in the current dictionary.
  718. /bdftops
  719.  { [] exch bdfafmtops
  720.  } bind def
  721. /bdfafmtops        % infilename afmfilename* outfilename fontname
  722.             %   encoding uniqueID
  723.  { envBDF begin
  724.      6 -2 roll exch 6 2 roll    % afm* in out fontname encoding uniqueID
  725.      readBDF        % afm* font
  726.      exch { readAFM } forall
  727.      save exch
  728.      dup /FontName get exch definefont
  729.      setfont
  730.      psfile writefont
  731.      restore
  732.      psfile closefile
  733.    end
  734.  } bind def
  735.  
  736. % If the program was invoked from the command line, run it now.
  737. [ shellarguments
  738.  { counttomark 4 ge
  739.     { dup 0 get
  740.       dup 48 ge exch 57 le and        % last arg starts with a digit?
  741.        { cvi /StandardEncoding }        % no encodingname
  742.        { cvn exch cvi exch }            % have encodingname
  743.       ifelse
  744.       counttomark 4 roll
  745.       counttomark 5 sub array astore
  746.       6 -4 roll exch
  747.       bdfafmtops
  748.     }
  749.     { cleartomark
  750.       (Usage: bdftops xx.bdf [yy1.afm ...] zz.gsf fontname uniqueID [encodingname]\n) print flush
  751.       mark
  752.     }
  753.    ifelse
  754.  }
  755. if pop
  756.